home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / message / msgbox2 / _msgbox.bas next >
Encoding:
BASIC Source File  |  1995-01-16  |  7.0 KB  |  219 lines
  1. Option Explicit
  2.  
  3. '==================
  4. 'Global Constants
  5. '==================
  6. Global Const KEY_RETURN = &HD
  7. Global Const CTRL_MASK = 2
  8. Global Const MINIMIZED = 1
  9. Global Const MSG = 0
  10. Global Const TTL = 1
  11. Global Const RETRY = 4
  12.  
  13. Global Const FIRST = 0
  14. Global Const SECOND_ = 256
  15. Global Const THIRD = 512
  16.  
  17. '======================
  18. 'API/DLL Declarations
  19. '======================
  20. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  21. Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Integer
  22. Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  23. Declare Function GetSystemDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  24.  
  25. ' Declare the fun needed to get the apps module handle
  26. Declare Function GetModuleHandle Lib "Kernel" (ByVal lpModuleName As String) As Integer
  27.  
  28. ' Declares to make CTL3D.DLL work
  29. Declare Function Ctl3dRegister Lib "CTL3D.DLL" (ByVal hInstance As Integer) As Integer
  30. Declare Function Ctl3dAutoSubClass Lib "CTL3D.DLL" (ByVal hInstance As Integer) As Integer
  31. Declare Function Ctl3dUnregister Lib "CTL3D.DLL" (ByVal hInstance As Integer) As Integer
  32.  
  33. '==================
  34. 'Global Variables
  35. '==================
  36. Global gintDefault As Integer
  37. Global gintIconstyle As Integer
  38. Global gintButtonStyle As Integer
  39. Global gintModal As Integer
  40. Global gstrCR As String
  41. Global gstrQ As String
  42. Global gstrTheMessage As String
  43. Global gstrRawMessage As String
  44. Global gstrTheTitle As String
  45.  
  46. Sub CenterOnForm (Parent As Form, Child As Form)
  47.  
  48.   Dim pintChildTop As Integer
  49.   Dim pintChildLeft As Integer
  50.  
  51.   pintChildTop = ((Parent.Height - Child.Height) / 2) + Parent.Top
  52.   pintChildLeft = ((Parent.Width - Child.Width) / 2) + Parent.Left
  53.  
  54.   If pintChildTop + Child.Height > screen.Height - 10 Then
  55.     pintChildTop = screen.Height - 10 - Child.Height
  56.   ElseIf pintChildTop < 10 Then
  57.     pintChildTop = 10
  58.   End If
  59.  
  60.   If pintChildLeft + Child.Width > screen.Width - 10 Then
  61.     pintChildLeft = screen.Width - 10 - Child.Width
  62.   ElseIf pintChildLeft < 10 Then
  63.     pintChildLeft = 10
  64.   End If
  65.  
  66.   Child.Move pintChildLeft, pintChildTop
  67.  
  68.  
  69. End Sub
  70.  
  71. ' Procedure Name:   GetSysDir As String
  72. '
  73. ' Arguments:  None
  74. '
  75. ' Note: Function will get the Windows System Directory
  76. '
  77. Function GetSysDir () As String
  78.  
  79.   Dim pintSize As Integer
  80.   Dim pintRetString As Integer
  81.   Dim pstrRet As String * 255  'Create an empty string to be filled
  82.  
  83.   pintSize = 255               'uncertain - possibly length of fill string
  84.  
  85.   ' Call API to get the windows directory
  86.   pintRetString = GetSystemDirectory(pstrRet, pintSize)
  87.   
  88.   ' Trim the return string
  89.   GetSysDir = Left$(pstrRet, pintRetString)
  90.  
  91. End Function
  92.  
  93. ' Procedure Name:   GetWinDir As String
  94. '
  95. ' Arguments:  None
  96. '
  97. ' Note: Function will get the Windows Directory
  98. '
  99. Function GetWinDir () As String
  100.  
  101.   Dim pintSize As Integer
  102.   Dim pintRetString As Integer
  103.   Dim pstrRet As String * 255  'Create an empty string to be filled
  104.  
  105.   pintSize = 255               'uncertain - possibly length of fill string
  106.  
  107.   ' Call API to get the windows directory
  108.   pintRetString = GetWindowsDirectory(pstrRet, pintSize)
  109.  
  110.   ' Trim the return string
  111.   GetWinDir = Left$(pstrRet, pintRetString)
  112.  
  113. End Function
  114.  
  115. ' Procedure: MakePath As String
  116. ' Arugments: szDir As String     Full directory path (with optional ending "\")
  117. '            szFile As String    Filename to append to directory
  118. ' Return:    Resulting fully qualified path name.
  119. '
  120. ' This function will add the two parts to return a fully qualified path name
  121. '
  122. Function MakePath (szDir As String, szFile As String) As String
  123.  
  124.     If szDir = "" Then
  125.         MakePath = szFile$
  126.     ElseIf szFile = "" Then
  127.         MakePath = szDir$
  128.     ElseIf Mid$(szDir, Len(szDir), 1) = "\" Then
  129.         MakePath = szDir + szFile
  130.     Else
  131.         MakePath = szDir + "\" + szFile
  132.     End If
  133.  
  134. End Function
  135.  
  136. ' Procedure Name:   ReadIni As String
  137. '
  138. ' Arguments:  AppName As String     The String in the [] in the named ini file
  139. '             KeyName As String     The string before the "=" in the ini file
  140. '             DefaultStr As String  Will be returned if no string is found
  141. '             IniFileName As String File name and path to that file "c:\test\test.ini"
  142. '
  143. ' Note: Function will read data from Private Profile (.ini) File
  144. '
  145. Function ReadIni (AppName As String, KeyName As String, DefaultStr As String, IniFileName As String) As String
  146.  
  147.   Dim pintSize As Integer
  148.   Dim pintRetString As Integer
  149.   Dim pstrRet As String * 255  'Create an empty string to be filled
  150.  
  151.   pintSize = 255               'uncertain - possibly length of fill string
  152.  
  153.   ' Call API to read ini
  154.   pintRetString = GetPrivateProfileString(AppName, KeyName, DefaultStr, pstrRet, pintSize, IniFileName)
  155.  
  156.   ' Trim the return string
  157.   ReadIni = Left$(pstrRet, pintRetString)
  158.  
  159. End Function
  160.  
  161. ' Procedure Name:   SaveIni
  162. '
  163. ' Arguments:    AppName As String      The String in the [] in the named ini file
  164. '               IniFileName As String  File name and path to that file "c:\test\test.ini"
  165. '               KeyName As String      The string before the "=" in the ini file
  166. '               NewVal As String       The string to be added to or changed in the ini file
  167. '
  168. ' Note: Will update INI file
  169. '
  170. Sub SaveIni (AppName As String, KeyName As String, NewVal As String, IniFileName As String)
  171.  
  172.   Dim pintResultCode As Integer
  173.  
  174.   pintResultCode = WritePrivateProfileString(AppName, KeyName, NewVal, IniFileName)
  175.   If pintResultCode = 0 Then
  176.     Call Turn3dOnOff
  177.     MsgBox "Error updating INI file!", 16, "ERROR!"
  178.     Call Turn3dOnOff
  179.   End If
  180.  
  181. End Sub
  182.  
  183. ' Procedure:   Turn3dOnOff
  184. ' Arguments:  None
  185. '
  186. ' Note: This sub will turn the 3d of the CTL3D.DLL or CTL3DV2.DLL on and off.
  187. '       This can be used throughout an app (saffer) or just once to trun it
  188. '       on then once to turn it off.
  189. '
  190. Sub Turn3dOnOff ()
  191.  
  192.   Static pintInst As Integer ' Holds the inst handle of the app
  193.   Static pint3dOn As Integer ' Holds flag of if 3d is on (true) or off (false)
  194.   Dim pintTemp As Integer    ' Temp not to be used
  195.  
  196.   ' For safty exit function if no CTL3D.DLL in system dirs
  197.   If Dir(MakePath(GetSysDir(), "CTL3D.DLL")) = "" And Dir(MakePath(GetWinDir(), "CTL3D.DLL")) = "" Then
  198.     Exit Sub
  199.   End If
  200.  
  201.   If pintInst = 0 Then       ' If no inst handle retreved yet
  202.     ' Get an inst handle for this app
  203.     pintInst = GetModuleHandle((app.EXEName))
  204.   End If
  205.  
  206.   If pint3dOn Then           ' If pint3dOn flag is true (3d is on)
  207.     ' Unregister 3d (turn 3d off)
  208.     pintTemp = Ctl3dUnregister(pintInst)
  209.     pint3dOn = False
  210.   Else
  211.     ' Register 3d (turn 3d on)
  212.     pintTemp = Ctl3dRegister(pintInst)
  213.     pintTemp = Ctl3dAutoSubClass(pintInst)
  214.     pint3dOn = True
  215.   End If
  216.  
  217. End Sub
  218.  
  219.